home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / amiga / gcc233.lha / geninline / conv.p.orig < prev    next >
Text File  |  1992-08-10  |  13KB  |  411 lines
  1. #!/c/perl
  2. # convert pair of clib/proto header and fd file into an inline header
  3. #
  4. # (C) 1992 by Markus Wild
  5. # <wild@nessie.cs.id.ethz.ch> or <wild@amiga.physik.unizh.ch>
  6. #
  7. # this tool requires PERL.
  8. #
  9. # 1.1   92-jun-04    now handles double arguments
  10. # 1.2   92-jul-02    generates stdarg and alias macros. 
  11. # 1.3   92-jul-08    makes use of 2.2.2's new "memory" clobbering, and no longer
  12. #            emits those *(char*)a0=*(char*)a0 hacks.
  13. #
  14. # TODO: handle full ANSI declarations, 
  15. #       eg. void qsort (void *, size_t, size_t, int (*)(const void *, const void *));
  16. #       Currently omit the declaration of the arguments of the function pointers,
  17. #       ie. in this example, use
  18. #       void qsort (void *, size_t, size_t, int (*)());
  19. #
  20. #       perform register allocation in those cases where a4 or a5 is used
  21. #       automatically.
  22. #
  23.  
  24. $#ARGV == 1 || die "Usage: $0 proto-file fd-file\n";
  25.  
  26. open(PROTO_F, $ARGV[0]) || die "Can't open $ARGV[0], $!";
  27. open(FD_F, $ARGV[1]) || die "Can't open $ARGV[1], $!";
  28.  
  29. # set the input record separator to ; to be able to parse multiline 
  30. # declarations. This could get us into troubles with comments.. we will see
  31. $/=";";
  32.  
  33. p_line: while (<PROTO_F>) {
  34. #print "0: ",$_,"\n";
  35.  
  36.   # skip proprocessor statements and comments
  37.   s/\n+/\n/g;
  38. #print "01: ", $_, "\n";
  39.   s/(#.*\n)+//g;
  40. #print "02: ", $_, "\n";
  41.   s/\/\*([^\*]*\*+)*\///g;
  42. #print "03: ", $_, "\n";
  43.   s/^([^\n\(]+\n)+//g;
  44.   
  45.   next if $_ eq "";
  46.   next unless /\(/;
  47.   
  48.   # suppose this is a function declaration
  49.   # this `little' pattern filters out the return type and the argument
  50.   # line. The return type is quite tricky, since it can be a multi word
  51.   # type (like struct foo *), and we shouldn't overwrite the function
  52.   # name by matching against the return type... this seems to work, although
  53.   # I'm not completly sure it does in all cases.
  54.  
  55. #print "1: ",$_;
  56.   s/\(\s*\*/\(\*/g;
  57. #print "2: ",$_;
  58.   s/\s+(\([^\*])/\(\1/g;
  59. #print "3: ",$_;
  60.   /((\w+\s)*\w+\W+)(\w+)\((([^,\(\)]+|\([^\)]*\)|,|\s)*)\)([^;]*);/;
  61.  
  62.   # %result_tab contains the type part written before the function name
  63.   $result_tab{$3} = $1;
  64.   # %result_tab_end contains the type part written after the closing parenthesis
  65.   chop $6;
  66.   $result_tab_end{$3} = $6;
  67.   # %arg_type_tab contains (later only) the type information for the arguments
  68.   $arg_type_tab{$3} = $4;
  69.   
  70.   # compress the types, throw out not needed whitespace as much as we can
  71.   $result_tab{$3} =~ s/\s+/ /g;
  72.   $result_tab_end{$3} =~ s/\s+/ /g;
  73.   $result_tab_end{$3} =~ s/(\s+$)|(^\s+)//g;
  74.   $arg_type_tab{$3} =~ s/\s+/ /g;
  75.   $arg_type_tab{$3} =~ s/\s*,\s*/,/g;
  76.   $arg_type_tab{$3} =~ s/(\s+$)|(^\s+)//g;
  77. }
  78.  
  79. # now parse the given fd file
  80.  
  81. # reset input record separator to newline for fd file
  82. $/="\n";
  83. $bias = 0;
  84. $private = 0;
  85. ($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($lib_base_name = "${2}Base");
  86. $lib_base_name[0] =~ tr/[a-z]/[A-Z]/;
  87.  
  88. f_line: while (<FD_F>) {
  89.   # strip terminating new line
  90.   chop;
  91.  
  92.   # get rid of comments
  93.   /^\*/ && next f_line;
  94.  
  95.   # parse commands
  96.   /^##base _(\w+)/    && ($lib_base_name = $1) && next f_line;
  97.   /^##bias (\d+)/    && ($bias = $1)         && next f_line;
  98.   /^##public/        && (($private = 0), 1)     && next f_line;
  99.   /^##private/        && ($private = 1)     && next f_line;
  100.  
  101.   # parse function
  102.   /^(\w+)\(([^\)]*)\)\(([^\)]*)\)/;
  103.   
  104.   $reg_tab{$1} = $3;
  105.   $arg_name_tab{$1} = $2;
  106.   $bias_tab{$1} = $bias;
  107.  
  108.   $bias += 6;
  109. }
  110.  
  111. %base_types = (
  112.   'SysBase',        'struct ExecBase *',
  113.   'ConsoleDevice',    'struct Device *',
  114.   'TimerBase',        'struct Device *',
  115.   'DiskfontBase',    'struct Library *',
  116.   'DOSBase',        'struct DosLibrary *',
  117.   'IconBase',        'struct Library *',
  118.   'PotgoBase',        'struct Library *',
  119.   'TranslatorBase',    'struct Library *',
  120.   'XpkBase',        'struct Library *',
  121.   'XpkSubBase',        'struct Library *',
  122. );
  123.  
  124. ($lib_base_type = $base_types{$lib_base_name}) || 
  125.   ($lib_base_type = "struct " . $lib_base_name . "* ");
  126.  
  127. # convert arg_name_tab and arg_type_tab into arg_tab. This is rather tricky...
  128.  
  129. foreach $func (sort keys(%arg_name_tab)) {
  130.   $_=$arg_name_tab{$func};
  131.   if ($_ eq "" || /^\s*void\s*/i)
  132.     {
  133.       # no arguments given, or just void or VOID
  134.       $arg_tab{$func} = "";
  135.       next;
  136.     }
  137.   else
  138.     {
  139.       # unpack arguments into array @names
  140.       @names = split(/,/, $arg_name_tab{$func});
  141.       # NOTE: this trick fails if someone specifies full prototypes for
  142.       #       function pointers, ie. (.., (*func)(int, int, int), ...).
  143.       #       Currently just one function in graphics.h does this, so it's
  144.       #       not worth the hassle to do it `right'.
  145.       @types = split(/,/, $arg_type_tab{$func});
  146.       # @types may still contain argument names, if they were specified
  147.       # in the proto file. This is a tricky task, separate the optional
  148.       # argument name...
  149.       foreach $i (0 .. $#types) {
  150.         @words = split(/ /,$types[$i]);
  151.         $wi=$#words;
  152.     word_loop: while ($wi > 0)
  153.       {
  154.             if ($words[$wi] =~ /[\(\)]/ && !($words[$wi - 1] =~ /[\(\)]/))
  155.               {
  156.         last word_loop;
  157.           }
  158.         elsif (!($words[$wi] =~ /[\(\)]/))
  159.           {
  160.             last word_loop;
  161.           }
  162.         $wi--;
  163.       }
  164.     # here come heuristics... (do we have a name to write over or 
  165.     # do we have to append a new element?)
  166.     if ($words[$wi] eq "int" ||
  167.         $words[$wi] eq "long" ||
  168.         $words[$wi] eq "short" ||
  169.         $words[$wi] eq "char" ||
  170.         $words[$wi] eq "*")
  171.       {
  172.         $wi++;
  173.       }
  174.     ($words[$wi] =~ s/(\W*)(\w+)(.*)/\1$names[$i]\3/) ||
  175.       ($words[$wi] = $names[$i]);
  176.     $types[$i] = "@words";
  177.       }
  178.       $arg_tab{$func} = join("|", @types);
  179.     }
  180. }
  181.  
  182. # this table maps functions that have an alternate stdarg-companion
  183. # it would probably be better (and more generic) to do this mapping with
  184. # some rather weird regular expressions. However, since almost every header
  185. # file chose a different set of naming `rules' how to deduce the stdarg-name
  186. # from the plain name, it would probably not be much better for the future,
  187. # there's no sign that this deliberate creativity in inventing new naming
  188. # conventions should stop....
  189.  
  190. %stdarg_names = (
  191.   # asl.library
  192.   'AllocAslRequest',    'AllocAslRequestTags',
  193.   'AslRequest',        'AslRequestTags',
  194.   # dos.library
  195.   'AllocDosObject',    'AllocDosObjectTags',
  196.   'CreateNewProc',    'CreateNewProcTags',
  197.   'SystemTagList',    'SystemTags',
  198.   'NewLoadSeg',        'NewLoadSegTags',
  199.   # gadtools.library
  200.   'CreateGadgetA',    'CreateGadget',
  201.   'GT_SetGadgetAttrsA',    'GT_SetGadgetAttrs',
  202.   'CreateMenusA',    'CreateMenus',
  203.   'LayoutMenuItemsA',    'LayoutMenuItems',
  204.   'LayoutMenusA',    'LayoutMenus',
  205.   'DrawBevelBoxA',    'DrawBevelBox',
  206.   'GetVisualInfoA',    'GetVisualInfo',
  207.   # graphics.library
  208.   'VideoControl',    'VideoControlTags',    # own creation ;-)
  209.   'WeighTAMatch',    'WeighTAMatchTags',    # own creation ;-)
  210.   'ExtendFont',        'ExtendFontTags',    # own creation ;-)
  211.   # intuition.library
  212.   'OpenWindowTagList',    'OpenWindowTags',
  213.   'OpenScreenTagList',    'OpenScreenTags',
  214.   'NewObjectA',        'NewObject',
  215.   'SetAttrsA',        'SetAttrs',
  216.   'SetGadgetAttrsA',    'SetGadgetAttrs',
  217.   # workbench.library
  218.   'AddAppWindowA',    'AddAppWindow',
  219.   'AddAppIconA',    'AddAppIcon',
  220.   'AddAppMenuItemA',    'AddAppMenuItem',
  221. );
  222.  
  223.  
  224. # these are aliases for some functions, that for what reason ever got two
  225. # names for the same entry point. This is a dos.library pecularity..
  226. # the list is symmetric, since it's random which of the two names actually
  227. # appears in the fd file, and is thus generated inline...
  228. %aliased_names = (
  229.   'AllocDosObjectTagList',    'AllocDosObject',
  230.   'AllocDosObject',        'AllocDosObjectTagList',
  231.   'CreateNewProcTagList',    'CreateNewProc',
  232.   'CreateNewProc',        'CreateNewProcTagList',
  233.   'SystemTagList',        'System',
  234.   'System',            'SystemTagList',
  235.   'NewLoadSegTagList',        'NewLoadSeg',
  236.   'NewLoadSeg',            'NewLoadSegTagList',
  237. );
  238.  
  239. # now output the real file
  240.  
  241. ($ARGV[0] =~ /([^:\/]*[:\/])*(\w+)\.h/) && ($def = $2 . "_H");
  242. $def =~ s/_protos//;
  243. $def =~ tr/[a-z]/[A-Z]/;
  244.  
  245. print "#ifndef _INLINE_$def\n#define _INLINE_$def\n\n";
  246.  
  247. print "#include <sys/cdefs.h>\n";
  248. print "#include <inline/stubs.h>\n";
  249.  
  250. # this is for C++ support, it does `extern "C" {' if __cplusplus is defined
  251. print "\n__BEGIN_DECLS\n\n";
  252.  
  253. print "#ifndef BASE_EXT_DECL\n";
  254. print "#define BASE_EXT_DECL extern $lib_base_type $lib_base_name;\n";
  255. print "#endif\n";
  256.  
  257. print "#ifndef BASE_PAR_DECL\n";
  258. print "#define BASE_PAR_DECL\n";
  259. print "#define BASE_PAR_DECL0 void\n";
  260. print "#endif\n";
  261.  
  262. print "#ifndef BASE_NAME\n";
  263. print "#define BASE_NAME $lib_base_name\n";
  264. print "#endif\n\n";
  265.  
  266. foreach $func (sort keys(%result_tab)) {
  267.   # this happens if the clib/ file defines functions that only exist in amiga.lib
  268.   next if $bias_tab{$func} == 0;
  269.  
  270.   print "static __inline ",$result_tab{$func},"\n";
  271.  
  272.   if ($arg_tab{$func} eq "")
  273.     {
  274.       print $func," (BASE_PAR_DECL0)\n{\n";
  275.     }
  276.   else
  277.     {
  278.       print $func," (BASE_PAR_DECL ",join(",", split(/\|/, $arg_tab{$func})),")\n{\n";
  279.     }
  280.   print "  BASE_EXT_DECL\n";
  281.   if (!($result_tab{$func} =~ /^\s*void\s*$/i))
  282.     {
  283.       print "  register $result_tab{$func} _res $result_tab_end{$func} __asm(\"d0\");\n";
  284.     }
  285.   print "  register ${lib_base_type}a6 __asm(\"a6\") = BASE_NAME;\n";
  286.   @args = split(/\|/, $arg_tab{$func});
  287.   @names = split(/,/, $arg_name_tab{$func});
  288.   @regs = split(/[\/,]/, $reg_tab{$func});
  289.   $warn_a4a5 = 0;
  290.   $owe_nl = 0;
  291.  
  292.   if ($#args >= 0)
  293.     {
  294.       # map the fd given register list to the arguments. If there wasn't 
  295.       # DOUBLE/double, then this mapping would be 1:1, but a double variable
  296.       # is specified as taking d0/d1 in the fd file, while gcc only wants to
  297.       # see the d0.
  298.  
  299.       $i = 0;
  300.       $ri = 0;
  301.       @reg_args = ();
  302.       while ($i <= $#args)
  303.         {
  304.           $reg_args[$i] = $regs[$ri];
  305.       # double, but not double pointers, skip one register
  306.       if ($args[$i] =~ /double[^\*]*$/i)
  307.         {
  308.           $ri+=2;
  309.         }
  310.       else
  311.         {
  312.           $ri++;
  313.         }
  314.       $decl = $args[$i];
  315.       $decl =~ s/(\W)$names[$i](\W?)/\1$reg_args[$i]\2/;
  316.           print "  register $decl __asm(\"$reg_args[$i]\") = $names[$i];\n";
  317.           $i++;
  318.         }
  319.     }
  320.   printf "  __asm __volatile (\"jsr a6@(-0x%x)\"\n", $bias_tab{$func};
  321.   if ($result_tab{$func} =~ /^\s*void\s*$/i)
  322.     {
  323.       print "  : /* no output */\n";
  324.     }
  325.   else
  326.     {
  327.       print "  : \"=r\" (_res)\n";
  328.     }
  329.   if ($#args == -1)
  330.     {
  331.       print "  : \"r\" (a6)\n";
  332.     }
  333.   else
  334.     {
  335.       print "  : \"r\" (a6)";
  336.       foreach $r (@reg_args) {
  337.         print ", \"r\" ($r)";
  338.       }
  339.       print "\n";
  340.     }
  341.  
  342.   @clobb=("d0", "d1", "a0", "a1");
  343.   push (@clobb, @regs);
  344.   @clobb = sort(@clobb);
  345.   print "  : ";
  346.   # specify "memory" in each call, since each call is a subroutine call to some
  347.   # space which may do things we don't know ;-) Besides, this shouldn't hurt
  348.   # performance, and if it does, I'd need specific information HOW it hurts,
  349.   # so "memory" could be disabled in just those cases.
  350.   foreach $i (0 .. $#clobb) {
  351.     (($clobb[$i] ne $clobb[$i+1]) && ($i != $#clobb) && (print "\"$clobb[$i]\",")) ||
  352.     ($i == $#clobb && (print "\"$clobb[$i]\", \"memory\");\n"));
  353.   }
  354.  
  355. # no longer necessary, since gcc now supports `register' "memory" to denote
  356. # that memory is clobbered by indirection on registers
  357. #
  358. #  # hack.. for all arguments addressed via address registers, fake a value change
  359.   foreach $i (0 .. $#regs) {
  360. #    ($regs[$i] =~ /a[0-5]/) && 
  361. #     (print "  *(char *)$regs[$i] = *(char *)$regs[$i];") && ($owe_nl= 1);
  362.     ($regs[$i] =~ /a[45]/) && ($warn_a4a5 = 1);
  363.   }
  364.   print STDERR "Warning: $func uses a4 or a5, add code to save/restore them!\n"
  365.     if $warn_a4a5;
  366.  
  367.   print "\n" if ($owe_nl);
  368.   print "  return _res;\n" if (!($result_tab{$func} =~ /^\s*void\s*$/i));
  369.   print "}\n";
  370.   
  371.   if ($stdarg_names{$func})
  372.     {
  373.       print "#ifndef NO_INLINE_STDARG\n";
  374.       print "#define $stdarg_names{$func}(";
  375.       foreach $i (0 .. $#args-1) {
  376.     print "a$i, ";
  377.       }
  378.       print "tags...) \\\n";
  379.       print "  ({ struct TagItem _tags[] = { tags }; $func (";
  380.       foreach $i (0 .. $#args-1) {
  381.     print "(a$i), ";
  382.       }
  383.       print "_tags); })\n";
  384.       print "#endif /* not NO_INLINE_STDARG */\n";
  385.     }
  386.   
  387.   if ($aliased_names{$func})
  388.     {
  389.       # provide arguments to the macro, should reduce expansion of the macro
  390.       # at the wrong place..
  391.       print "#define $aliased_names{$func}(";
  392.       foreach $i (0 .. $#args-1) {
  393.     print "a$i, ";
  394.       }
  395.       print "a$#args) $func (";
  396.       foreach $i (0 .. $#args-1) {
  397.     print "(a$i), ";
  398.       }
  399.       print "(a$#args))\n";
  400.     }
  401. }
  402.  
  403. print "#undef BASE_EXT_DECL\n";
  404. print "#undef BASE_PAR_DECL\n";
  405. print "#undef BASE_PAR_DECL0\n";
  406. print "#undef BASE_NAME\n";
  407.  
  408. print "\n__END_DECLS\n\n";
  409.  
  410. print "#endif /* _INLINE_$def */\n";
  411.